home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung 2 / Power-Programmierung CD 2 (Tewi)(1994).iso / c / library / mslang / sktdem / simpsktp.pa_ / simpsktp.pa
Encoding:
Text File  |  1994-02-14  |  3.7 KB  |  136 lines
  1. program simpsktp;
  2.  
  3. { This program demonstrates the Apiary Network Sockets Toolkit. }
  4. { Copyright 1994 Intelec Systems Corporation, APIary }
  5. { syntax: SIMPSKTP: <LocalName> <RemoteName> }
  6.  
  7. { THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY
  8.   KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE
  9.   IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR
  10.   PURPOSE.
  11. }
  12.  
  13.  
  14. uses WinProcs, WinTypes, Objects, OWindows , Strings ,
  15.      ODialogs, OStdDlgs, OStdWnds, OMemory , SktUnit ;
  16.  
  17. {$R SIMPSKTP.RES}
  18.  
  19. type
  20.  
  21.   { The application object }
  22.   TSimpSktp = object(TApplication)
  23.     procedure InitMainWindow; virtual;
  24.   end;
  25.  
  26.   PMainWnd = ^TMainWnd;
  27.   TMainWnd = object(TWindow)
  28.     procedure SetupWindow; virtual;
  29.     function CanClose: Boolean; virtual;
  30.     procedure GetWindowClass( var aWndClass : TWndClass ); virtual;
  31.     procedure Send(var Msg: TMessage);
  32.                    virtual cm_First + 1;
  33.     procedure ExitC(var Msg: TMessage);
  34.                    virtual cm_First + 2;
  35.     procedure SktEvent(var Msg: TMessage);
  36.                        virtual Wm_First + Wm_SktEvent;
  37.   end;
  38.  
  39. var SimpSktpApp : TSimpSktp;
  40.     LocalName : array[ 0..16 ] of char;
  41.     RemoteName : array[ 0..16 ] of char;
  42.     hSocket : longint;
  43.     SMsg : array[ 0..127 ] of char;
  44.  
  45. procedure TMainWnd.ExitC(var Msg: TMessage);
  46. begin
  47.    PostMessage( HWindow , WM_CLOSE , 0 , 0 );
  48. end;
  49.  
  50. procedure TMainWnd.Send(var Msg: TMessage);
  51. var SndDlg : PInputDialog;
  52. begin
  53.     if ( New( PInputDialog ,
  54.               init( @Self , 'Send' ,
  55.               'Text to send:' ,
  56.               sMsg , sizeof( sMsg ) ) ) )^.Execute = IDOK then
  57.                   SktWrite( hSocket , sMsg , StrLen( sMsg ) , 0 );
  58. end;
  59.  
  60. procedure TMainWnd.SktEvent(var Msg: TMessage);
  61. var Evt : PSktEvent;
  62.     Tmp : array[ 0..127 ] of char;
  63. begin
  64.     Evt := PSktEvent( Msg.LParam );
  65.     case Msg.WParam of
  66.       SEV_READ:
  67.        begin
  68.              FillChar( Tmp , sizeof( Tmp ) , 0 );
  69.              Move( Evt^.lpBuffer[0] , Tmp , Evt^.dwLength );
  70.          MessageBox( hWindow ,
  71.                   Tmp ,
  72.                  'Socket Event Read' ,
  73.                  MB_ICONEXCLAMATION );
  74.        end;
  75.       SEV_WRITE:
  76.        begin
  77.          MessageBox( hWindow ,
  78.              'Message sent!' ,
  79.              'Socket Event Write' ,
  80.              MB_ICONEXCLAMATION );
  81.        end;
  82.     end;
  83. end;
  84.  
  85. function TMainWnd.CanClose: Boolean;
  86. begin
  87.    if hSocket <> 0 then
  88.       SktClose( hSocket );
  89.    CanClose := True;
  90. end;
  91.  
  92. procedure TMainWnd.SetupWindow;
  93. begin
  94.   inherited SetupWindow;
  95.   if SktOpen( LocalName , 0 , HWindow , 128 , 1 , 1 , 0 ,
  96.                @hSocket ) <> 0 then
  97.       begin
  98.          MessageBox( GetFocus , 'Could not open socket' ,
  99.                      'Simple Socket Demo' ,
  100.                      MB_ICONSTOP );
  101.          PostMessage( hWindow , WM_CLOSE , 0  , 0 );
  102.          exit;
  103.       end;
  104.   SktSetTarget( hSocket , RemoteName , 0 , nil );
  105.   SetMenu( hWindow , LoadMenu( hInstance , 'MAIN_MENU' ) );
  106. end;
  107.  
  108. procedure TMainWnd.GetWindowClass( var aWndClass: TWndClass );
  109.    begin
  110.       inherited GetWindowClass( aWndClass );
  111.       aWndClass.hIcon := LoadIcon( hinstance , 'ICON_1' );
  112.    end;
  113.  
  114. procedure TSimpSktp.InitMainWindow;
  115. begin
  116.   MainWindow := New( PMainWnd , Init( nil ,'Simple Socket Demo' ) );
  117. end;
  118.  
  119.  
  120. begin
  121.   if ParamCount < 2 then
  122.     begin
  123.       MessageBox( GetFocus , 'syntax:'#13'SIMPSKTP <LocalName> <RemoteName>' ,
  124.                   'Simple Socket Demo' ,
  125.                   MB_ICONSTOP );
  126.     end
  127.   else
  128.     begin
  129.       StrPCopy( LocalName , ParamStr( 1 ) );
  130.       StrPCopy( RemoteName , ParamStr( 2 ) );
  131.       SimpSktpApp.Init( nil );
  132.       SimpSktpApp.Run;
  133.       SimpSktpApp.Done;
  134.     end;
  135. end.
  136.